home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist01.zoo / lsp / matrix.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-11-09  |  1.5 KB  |  46 lines
  1. ; Matrix functions by Tom Almy
  2. ; Multidimensional arrays are implemented here as arrays of arrays
  3. ; make-array is redefined to mimic common lisp
  4. ; Unfortunately AREF cannot be changed since its operation in setf is
  5. ; "wired in", so we will use a new (macro) function MREF
  6.  
  7.  
  8. (when (eq (type-of (symbol-function 'make-array))
  9.       'subr)
  10.       (setf (symbol-function 'orig-make-array)
  11.         (symbol-function 'make-array)))
  12.  
  13. (defun make-array (dims &key initial)
  14.     (cond ((null dims) initial)
  15.       ((atom dims) (make-array (list dims) :initial initial))
  16.       (t (let ((result (orig-make-array (first dims))))
  17.            (when (or (rest dims) initial)
  18.              (dotimes (i (first dims))
  19.                   (setf (aref result i)
  20.                     (make-array (rest dims) :initial initial))))
  21.            result))))
  22.  
  23. ; macro version of accessing function -- this is slow
  24. ; (defmacro mref (matrix &rest indices)
  25. ;   (cond ((null indices) matrix)
  26. ;         ((null (rest indices)) `(aref ,matrix ,(first indices)))
  27. ;     (t `(mref ,(aref (eval matrix) (first indices)) ,@(rest indices)))))
  28.  
  29.  
  30. ; The function version is faster, but not as elegant (??)
  31.  
  32.  
  33. (defun mref (matrix &rest indices)
  34.     (dolist (index indices)
  35.         (setq matrix (aref matrix index)))
  36.     matrix)
  37.  
  38. (setf (get 'mref '*setf*)
  39.       #'(lambda (mat &rest arglist)
  40.       (do ((index (first arglist) (first remainder))
  41.            (remainder (rest arglist) (rest remainder)))
  42.           ((null (rest remainder))
  43.            (setf (aref mat index) (first remainder)))
  44.         (setf mat (aref mat index)))))
  45.  
  46.